home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / mscrol.exe / MUSTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-26  |  7.1 KB  |  243 lines
  1.  
  2. {$A+}   { Align data }
  3. {$B-}   { Boolean evaluation }
  4. {$D-}   { Debug information }
  5. {$F-}   { Force FAR calls }
  6. {$G+}   { 80286 code }
  7. {$I-}   { I/O checking }
  8. {$K-}   { Smart Callbacks }
  9. {$L+}   { Local symbols }
  10. {$N-}   { 80x87 code }
  11. {$O-}   { Overlays allowed }
  12. {$P-}   { Open parameters }
  13. {$R-}   { Range checking }
  14. {$S-}   { Stack checking }
  15. {$Q-}   { Overflow checking }
  16. {$T-}   { Typed @ operators }
  17. {$V-}   { String VAR checking }
  18. {$W-}   { Windows stack frame for real mode }
  19. {$X+}   { Extended syntax }
  20. {$Y+}   { Symbol reference information }
  21.  
  22. {$M 4096,4096}
  23.  
  24. { This is a Pascal version of the C program MUSTEST.C from the MS
  25.   Developer's Network CD Fall/92. Doesn't do anything useful, just
  26.   shows how to use the Spin Buttons implemented in MUSCROLL.DLL.
  27.  
  28.   If you find any bugs please let me know.
  29.   Olaf He▀ (Hess), Munich, Germany.
  30.   CompuServe ID: 100 031, 35 36
  31. }
  32.  
  33. PROGRAM MiniScrollTest;
  34.  
  35. {$R MUSTEST.RES}
  36.  
  37. USES WinTypes, WinProcs, OWindows, ODialogs, MuScroll;
  38.  
  39. CONST
  40.     id_Edit1 = 101;
  41.     id_Edit2 = 102;
  42.     id_VertScroll  = 201;
  43.     id_HorizScroll = 202;
  44.  
  45. TYPE
  46.     TMiniApp = OBJECT (TApplication)
  47.         PROCEDURE InitMainWindow; VIRTUAL;
  48.     END; { TMiniApp }
  49.  
  50.     PTestDlg = ^TTestDlg;
  51.     TTestDlg = OBJECT (TDlgWindow)
  52.         pToEdit1, pToEdit2 : PEdit;
  53.         hVertScroll, hHorizScroll : hWnd;
  54.  
  55.         CONSTRUCTOR Init (AParent: PWindowsObject; AName: PChar);
  56.         PROCEDURE SetupWindow; VIRTUAL;
  57.  
  58.         PROCEDURE wmVScroll (VAR Msg: TMessage);
  59.             VIRTUAL wm_First + wm_VScroll;
  60.         PROCEDURE wmHScroll (VAR Msg: TMessage);
  61.             VIRTUAL wm_First + wm_HScroll;
  62.     END; { TTestDlg }
  63.  
  64. (* ---- *)
  65.  
  66. PROCEDURE TMiniApp.InitMainWindow;
  67. { Initialize window object }
  68.  
  69. BEGIN
  70.     MainWindow := New (PTestDlg, Init (NIL, 'TestDialog'));
  71. END; { TMiniApp.InitMainWindow }
  72.  
  73. (* ---- *)
  74.  
  75. CONSTRUCTOR TTestDlg.Init (AParent: PWindowsObject; AName: PChar);
  76. { Set up the dialogbox }
  77.  
  78. BEGIN
  79.     Inherited Init (AParent, AName); { Call ancestor }
  80.  
  81.     { Create control object for edit control }
  82.     New (pToEdit1, InitResource (@SELF, id_Edit1, 3));
  83.     New (pToEdit2, InitResource (@SELF, id_Edit2, 30));
  84. END; { TTestDlg.Init }
  85.  
  86. (* ---- *)
  87.  
  88. PROCEDURE TTestDlg.SetupWindow;
  89. { Initialize controls }
  90.  
  91. BEGIN
  92.     Inherited SetupWindow;
  93.  
  94.     { Insert number into the edit controls }
  95.     pToEdit1^.Insert ('50');
  96.     pToEdit2^.Insert ('Horizontal Edit Control');
  97.  
  98.     { Get hWnd of controls }
  99.     hVertScroll := GetDlgItem (hWindow, id_VertScroll);
  100.     hHorizScroll := GetDlgItem (hWindow, id_HorizScroll);
  101.  
  102.     { Set the range of the horizontal spin button }
  103.     SendMessage (hVertScroll, msm_dwRangeSet, 0, MakeLong (1, 99));
  104.     SendMessage (hVertScroll, msm_wCurrentPosSet, 50, 0);
  105.  
  106.     { Change the colors of the vertical spin button }
  107.     MSCrColorSet (hHorizScroll, MSColor_Face,   RGB    (0,   0,   255));
  108.     MSCrColorSet (hHorizScroll, MSColor_Arrow,  RGB    (255, 255, 255));
  109.     MSCrColorSet (hHorizScroll, MSColor_Shadow, RGB    (0,   0,   128));
  110.     MSCrColorSet (hHorizScroll, MSColor_HighLight, RGB (0,   255, 255));
  111. END; { TTestDlg.SetupWindow }
  112.  
  113. (* ---- *)
  114.  
  115. PROCEDURE TTestDlg.wmVScroll (VAR Msg: TMessage);
  116. { One of the thumb-buttons of the vertical spin button control has been
  117.   pressed }
  118.  
  119. VAR
  120.     wPos, wMax, wMin, wNum : Word;
  121.     lRange : LongInt;
  122.     fIsValid : bool;
  123.     szNum : ARRAY [0..2] OF Char;
  124.     awDummy : ARRAY [1..1] OF Word;
  125.  
  126. BEGIN
  127.     SetFocus (pToEdit1^.hWindow); { Set focus on edit control }
  128.  
  129.     WITH Msg DO
  130.         IF (lParamHi = hVertScroll) THEN
  131.         BEGIN { lParamHi = the hWindow of the mini scroll,
  132.                 not the control id! }
  133.  
  134.             { Ignore what comes from MSM_WCurrentPosSet -- See MUSTEST.C }
  135.             IF (wParam = sb_ThumbTrack) THEN Exit;
  136.  
  137.             wPos := lParamLo; { Get current spin button value }
  138.  
  139.             { Get minimum & maximum values allowed }
  140.             lRange := SendMessage (hVertScroll, msm_dwRangeGet, 0, 0);
  141.             wMax := HiWord (lRange);
  142.             wMin := LoWord (lRange);
  143.  
  144.             { Get the edit control's content }
  145.             wNum := GetDlgItemInt (hWindow, id_Edit1, @fIsValid, TRUE);
  146.  
  147.             { Check if we got a valid value from the control. Otherwise
  148.               use the current value. }
  149.             IF (fIsValid) AND (wNum >= wMin) THEN
  150.             BEGIN
  151.                 { If we are decrementing the value and (wNum - 1) = wPos,
  152.                   then we don't need TO modify anything. Otherwise, wPos
  153.                   must become wNum - 1 IF that is >= minimum. }
  154.  
  155.                 { Down arrow pressed }
  156.                 IF (wParam = sb_LineDown) AND ((wNum - 1) <> wPos) THEN
  157.                     IF (wNum > wMin) THEN wPos := wNum - 1
  158.                     ELSE wPos := wMin;
  159.  
  160.                 { Up arrow pressed }
  161.                 IF (wParam = sb_LineUp) AND ((wNum + 1) <> wPos) THEN
  162.                     IF (wNum < wMax) THEN wPos := wNum + 1
  163.                     ELSE wPos := wMax;
  164.             END; { if }
  165.  
  166.             IF (wPos <> wNum) THEN
  167.             BEGIN { Only change the control if we have to. }
  168.                 awDummy [1] := wPos;
  169.                 wvsprintf (szNum, '%d', awDummy);
  170.                 pToEdit1^.SetText (szNum);
  171.             END; { if }
  172.  
  173.             { Update the current position if it changed }
  174.             IF (wPos <> lParamLo) THEN
  175.                 SendMessage (hVertScroll, msm_wCurrentPosSet, wNum, 0);
  176.  
  177.             { We always want to do this is case the user typed something but
  178.               we could not scroll (like he typed in the max), in which
  179.               case the selection went away. }
  180.             SendMessage (pToEdit1^.hWindow, em_SetSel, 0,
  181.                          MakeLong (0, 32727));
  182.  
  183.             Result := 0;
  184.             Exit;
  185.         END; { if }
  186.  
  187.     DefWndProc (Msg);
  188. END; { TTestDlg.wmVScroll }
  189.  
  190. (* ---- *)
  191.  
  192. PROCEDURE TTestDlg.wmHScroll (VAR Msg: TMessage);
  193. { One of the thumb-buttons of the vertical spin button control has been
  194.   pressed }
  195.  
  196. VAR
  197.     lPos : LongInt;
  198.     wPos : Word;
  199.  
  200. BEGIN
  201.     SetFocus (pToEdit2^.hWindow); { Set focus on edit control }
  202.  
  203.     WITH Msg DO
  204.         IF (lParamHi = hHorizScroll) THEN
  205.         BEGIN
  206.             { Get selection }
  207.             lPos := SendMessage (pToEdit2^.hWindow, em_GetSel, 0, 0);
  208.             wPos := LoWord (lPos); { Starting point }
  209.  
  210.             { Left or right button pressed? }
  211.             IF (wParam = sb_LineUp) THEN
  212.             BEGIN { Right }
  213.                 Dec (wPos);
  214.                 IF (wPos < 0) THEN wPos := 0;
  215.             END { if }
  216.             ELSE
  217.             BEGIN { Left }
  218.                 Inc (wPos);
  219.                 IF (wPos > 32767) THEN wPos := 32767;
  220.             END; { else }
  221.  
  222.             lPos := MakeLong (wPos, wPos); { Set new position }
  223.             SendMessage (pToEdit2^.hWindow, em_SetSel, 0, lPos);
  224.         END { if }
  225.         ELSE DefWndProc (Msg);
  226. END; { TTestDlg.wmHScroll }
  227.  
  228. (* ---- *)
  229.  
  230. { Main program }
  231.  
  232. VAR
  233.     MiniApp : TMiniApp;
  234.  
  235. BEGIN { MiniScrollTest }
  236.     WITH MiniApp DO
  237.     BEGIN
  238.         Init (NIL);
  239.         Run;
  240.         Done;
  241.     END; { with }
  242. END. { MiniScrollTest }
  243.